home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / liboctave / CmplxAEPBAL.cc < prev    next >
C/C++ Source or Header  |  1996-03-03  |  2KB  |  102 lines
  1. /*
  2.  
  3. Copyright (C) 1996 John W. Eaton
  4.  
  5. This file is part of Octave.
  6.  
  7. Octave is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. Octave is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with Octave; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  20.  
  21. */
  22.  
  23. #if defined (__GNUG__)
  24. #pragma implementation
  25. #endif
  26.  
  27. #ifdef HAVE_CONFIG_H
  28. #include <config.h>
  29. #endif
  30.  
  31. #include <string>
  32.  
  33. #include "CmplxAEPBAL.h"
  34. #include "dMatrix.h"
  35. #include "f77-fcn.h"
  36.  
  37. extern "C"
  38. {
  39.   int F77_FCN (zgebal, ZGEBAL) (const char*, const int&, Complex*,
  40.                 const int&, int&, int&, double*, int&,
  41.                 long, long);
  42.  
  43.   int F77_FCN (zgebak, ZGEBAK) (const char*, const char*, const int&,
  44.                 const int&, const int&, double*, const
  45.                 int&, Complex*, const int&, int&,
  46.                 long, long);
  47. }
  48.  
  49. int
  50. ComplexAEPBALANCE::init (const ComplexMatrix& a, const string& balance_job)
  51. {
  52.   int n = a.cols ();
  53.  
  54.   if (a.rows () != n)
  55.     {
  56.       (*current_liboctave_error_handler) ("AEPBALANCE requires square matrix");
  57.       return -1;
  58.     }
  59.  
  60.   int info;
  61.   int ilo;
  62.   int ihi;
  63.  
  64.   Array<double> scale (n);
  65.   double *pscale = scale.fortran_vec ();
  66.  
  67.   balanced_mat = a;
  68.   Complex *p_balanced_mat = balanced_mat.fortran_vec ();
  69.  
  70.   char job = balance_job[0];
  71.  
  72.   F77_XFCN (zgebal, ZGEBAL, (&job, n, p_balanced_mat, n, ilo, ihi,
  73.                  pscale, info, 1L, 1L));
  74.  
  75.   if (f77_exception_encountered)
  76.     (*current_liboctave_error_handler) ("unrecoverable error in zgebal");
  77.   else
  78.     {
  79.       balancing_mat = Matrix (n, n, 0.0);
  80.       for (int i = 0; i < n; i++)
  81.     balancing_mat.elem (i, i) = 1.0;
  82.  
  83.       Complex *p_balancing_mat = balancing_mat.fortran_vec ();
  84.  
  85.       char side = 'R';
  86.  
  87.       F77_XFCN (zgebak, ZGEBAK, (&job, &side, n, ilo, ihi, pscale, n,
  88.                  p_balancing_mat, n, info, 1L, 1L));
  89.  
  90.       if (f77_exception_encountered)
  91.     (*current_liboctave_error_handler) ("unrecoverable error in zgebak");
  92.     }
  93.  
  94.   return info;
  95. }
  96.  
  97. /*
  98. ;;; Local Variables: ***
  99. ;;; mode: C++ ***
  100. ;;; End: ***
  101. */
  102.